home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
prog
/
atari
/
m2
/
cat3src
/
magic
/
rsccoder.m
< prev
next >
Wrap
Text File
|
1997-10-26
|
12KB
|
285 lines
MODULE RscCoder;
(* Wandelt ein RSC-File in formatierten Text.
* Fr MM2 als initialisiertes Konstanten-Feld, fr andere Compiler als
* CODE- bzw. INLINE-Prozedur. Ein solches RSC-File kann dann mittels
* mtRsc.RelocRsc wie ein normales RSC-File geladen werden. So ist es
* mglich, Resourcen im Programmcode zu halten, ohne eigenes RSC-File
* benutzen zu mssen.
*)
IMPORT SYSTEM;
IMPORT MagicSys, MagicAES, MagicConvert, MagicStrings, MagicDOS;
IMPORT mtDir, mtFiles, mtAppl, mtTextfiles, mtTime, mtRsc, mtDials, mtUtils;
(*----------------------------------------------------------------------*
* Resource-Coder 1.03 (C)92 by Peter Hellinger Software *
*----------------------------------------------------------------------*
* Inline-Resource erzeugt am 10.02.1992 17:01:30 *
*----------------------------------------------------------------------*)
TYPE tRscData = ARRAY [0..281] OF CARDINAL;
CONST RscData = tRscData {
00001H, 0013EH, 00122H, 0013EH, 00122H, 00122H, 00024H, 00122H, 00122H,
0022EH, 0000AH, 00001H, 00001H, 00000H, 00000H, 00000H, 00000H, 00232H,
05253H, 0432DH, 0436FH, 06465H, 07220H, 0312EH, 03033H, 02020H, 02045H,
0696EH, 0204DH, 06167H, 06963H, 04C69H, 0622DH, 0546FH, 06F6CH, 00028H,
04329H, 03139H, 03932H, 02046H, 05245H, 04557H, 04152H, 04520H, 04259H,
02050H, 04554H, 04552H, 02048H, 0454CH, 04C49H, 04E47H, 04552H, 02053H,
04F46H, 05457H, 04152H, 04500H, 00000H, 0496EH, 06974H, 06961H, 06C69H,
07369H, 06572H, 07465H, 0205BH, 04B6FH, 06E73H, 07461H, 06E74H, 06520H,
0286EH, 07572H, 02066H, 08172H, 0204DH, 04D32H, 02900H, 05072H, 06F7AH,
06564H, 07572H, 0206DH, 06974H, 0205BH, 0434FH, 04445H, 02D53H, 07461H,
07465H, 06D65H, 06E74H, 07320H, 02866H, 08172H, 02054H, 04449H, 02900H,
05072H, 06F7AH, 06564H, 07572H, 0206DH, 06974H, 0205BH, 0494EH, 04C49H,
04E45H, 02D53H, 07461H, 07465H, 06D65H, 06E74H, 07320H, 0284CH, 05052H,
02F53H, 05043H, 02900H, 0415BH, 05252H, 04159H, 0206DH, 06974H, 02049H,
06E69H, 07469H, 0616CH, 06973H, 06965H, 07275H, 06E67H, 0732DH, 05072H,
06F7AH, 06564H, 07572H, 0005BH, 04F6BH, 0005BH, 04162H, 06272H, 07563H,
06800H, 00000H, 00047H, 00000H, 00074H, 00000H, 00075H, 00005H, 00006H,
00002H, 00200H, 00000H, 0FFFFH, 0002DH, 00001H, 0FFFFH, 00001H, 00009H,
00014H, 00000H, 00010H, 00002H, 01100H, 00001H, 00001H, 00030H, 0000FH,
00002H, 0FFFFH, 0FFFFH, 01119H, 00000H, 00010H, 00001H, 01100H, 0002EH,
00000H, 00002H, 00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 00000H, 00010H,
00000H, 00024H, 00002H, 00001H, 0002BH, 00001H, 00004H, 0FFFFH, 0FFFFH,
00015H, 00000H, 00000H, 00000H, 00122H, 00002H, 00602H, 00021H, 00001H,
00005H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00001H, 00000H, 00076H, 00002H,
00004H, 0002BH, 00001H, 00006H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00000H,
00000H, 0009EH, 00002H, 00006H, 0002BH, 00001H, 00007H, 0FFFFH, 0FFFFH,
0121AH, 00015H, 00000H, 00000H, 000C6H, 00002H, 00008H, 0002BH, 00001H,
00008H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00000H, 00000H, 000F0H, 00002H,
0000AH, 0002BH, 00001H, 00009H, 0FFFFH, 0FFFFH, 0121AH, 00007H, 00000H,
00000H, 00115H, 00015H, 0000DH, 0000BH, 00001H, 00000H, 0FFFFH, 0FFFFH,
0121AH, 00425H, 00000H, 00000H, 00119H, 00022H, 0000DH, 0000BH, 00001H,
00000H, 0013EH, 00000H
}; (* Ende RscData *)
(*----------------------------------------------------------------------*)
CONST
Main = 0; (* Formular/Dialog *)
Formm2 = 4; (* BUTTON in Baum MAIN *)
Fortdi = 5; (* BUTTON in Baum MAIN *)
Forother = 6; (* BUTTON in Baum MAIN *)
Forarray = 7; (* BUTTON in Baum MAIN *)
Ok = 8; (* BUTTON in Baum MAIN *)
Cancel = 9; (* BUTTON in Baum MAIN *)
TYPE tCompiler = (mm2, tdi, array, other);
VAR Resource: ARRAY [0..07FFFH] OF CARDINAL; (* 64kb *)
inFile: ARRAY [0..255] OF CHAR;
inPath: ARRAY [0..255] OF CHAR;
inName: ARRAY [0..14] OF CHAR;
inSuff: ARRAY [0..5] OF CHAR;
outFile: ARRAY [0..255] OF CHAR;
outPath: ARRAY [0..255] OF CHAR;
outName: ARRAY [0..14] OF CHAR;
outSuff: ARRAY [0..5] OF CHAR;
str: ARRAY [0..255] OF CHAR;
in: mtFiles.FILE;
inBytes: LONGCARD;
out: mtTextfiles.TEXTFILE;
i, j, n, t, d: CARDINAL;
b: BOOLEAN;
VAR rsc: mtRsc.RESOURCE;
main: mtUtils.tObjcTree;
clip: mtUtils.tRect;
rect: mtUtils.tRect;
compiler: tCompiler;
objc: INTEGER;
PROCEDURE WriteHex (num: CARDINAL);
VAR str: ARRAY [0..10] OF CHAR;
i: CARDINAL;
BEGIN
MagicConvert.NumToStr (LONG(num), 4, 16, FALSE, str);
FOR i:= 0 TO LENGTH (str) DO
IF str[i] = ' ' THEN str[i]:= '0'; END;
END;
mtTextfiles.WriteConst (out, '0');
mtTextfiles.WriteLine (out, str);
mtTextfiles.WriteConst (out, 'H');
END WriteHex;
PROCEDURE WriteLine (REF str: ARRAY OF CHAR; newline: BOOLEAN);
BEGIN
mtTextfiles.WriteConst (out, str);
IF newline THEN mtTextfiles.WriteLn (out); END;
END WriteLine;
BEGIN
compiler:= mm2;
mtAppl.MouseBusy;
rect.x:= (mtAppl.MaxWidth DIV 2) - mtAppl.BoxWidth;
rect.y:= (mtAppl.MaxHeight DIV 2) - mtAppl.BoxHeight;
rect.w:= mtAppl.BoxWidth * 2;
rect.h:= mtAppl.BoxHeight * 2;
IF NOT mtRsc.RelocRsc (SYSTEM.CADR (RscData), rsc) THEN
mtAppl.ApplTerm (-1);
END;
mtAppl.MouseArrow;
mtAppl.MouseOn;
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
main:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Main);
IF NOT mtDials.NewDial (main) THEN mtAppl.ApplTerm (-1); END;
mtDials.DialCenter (main, mtDials.CSCREEN, 0, 0, clip);
mtDials.DialForm (main, mtDials.DGROW, rect, clip);
mtDials.DialForm (main, mtDials.DSTART, clip, clip);
mtDials.DialDraw (main, 0, 8, clip, FALSE);
LOOP
mtAppl.MouseArrow;
objc:= mtDials.DialDo (main, -1);
b:= mtUtils.DoubleClick (objc);
IF objc = Formm2 THEN compiler:= mm2;
ELSIF objc = Fortdi THEN compiler:= tdi;
ELSIF objc = Forother THEN compiler:= other;
ELSIF objc = Forarray THEN compiler:= array;
ELSIF objc = Cancel THEN EXIT;
ELSIF objc = Ok THEN
mtAppl.MouseOn;
IF mtDir.GetDir (inPath, inName, 'Resource whlen') THEN
MagicStrings.Assign (inPath, inFile);
mtDir.DelTail (inFile);
MagicStrings.Append (inName, inFile);
MagicStrings.Assign (inPath, outPath);
mtDir.DelTail (outPath);
MagicStrings.Append ('*.COD', outPath);
mtDir.Replace (inName, '*.COD', outName);
mtAppl.MouseOn;
IF mtDir.GetDir (outPath, outName, 'Codedatei whlen') THEN
mtAppl.MouseBusy;
MagicStrings.Assign (outPath, outFile);
mtDir.DelTail (outFile);
MagicStrings.Append (outName, outFile);
(* Resource-Array lschen *)
FOR i:= 0 TO 07FFFH DO Resource[i]:= 0; END;
(* Resource lesen *)
mtFiles.OpenFile (inFile, in);
IF in > 0 THEN
inBytes:= LONG (0FFFFH); (* Max 64kb *)
mtFiles.ReadFile (in, inBytes, SYSTEM.ADR(Resource));
mtFiles.CloseFile (in);
END;
(* Eventuell vorhandenes File lschen *)
b:= MagicDOS.Fdelete (outFile);
(* Codefile erzeugen *)
IF mtTextfiles.OpenTextfile (outFile, mtTextfiles.WRITE, 20480, out) THEN
WriteLine ('(*----------------------------------------------------------------------*', TRUE);
WriteLine (' * Resource-Coder 1.03 (C)92 by Peter Hellinger Software *', TRUE);
WriteLine (' *----------------------------------------------------------------------*', TRUE);
WriteLine (' * Inline-Resource erzeugt am ', FALSE);
mtTime.DateString (MagicDOS.Tgetdate (), str); WriteLine (str, FALSE);
WriteLine (' ', FALSE);
mtTime.TimeString (MagicDOS.Tgettime (), str); WriteLine (str, FALSE);
WriteLine (' *', TRUE);
WriteLine (' *----------------------------------------------------------------------*)', TRUE);
WriteLine (' ', TRUE);
IF compiler = mm2 THEN
(* Typ schreiben *)
WriteLine ('TYPE tRscData = ARRAY [0..', FALSE);
mtTextfiles.WriteCard (out, Resource[17] DIV 2, 0);
WriteLine ('] OF CARDINAL;', TRUE); WriteLine (' ', TRUE);
(* Daten schreiben *)
WriteLine ('CONST RscData = tRscData {', TRUE);
j:= 0; n:= 0;
LOOP
IF j > Resource[17] THEN EXIT END;
WriteLine (' ', FALSE);
FOR i:= 0 TO 8 DO
IF j > Resource[17] THEN EXIT END;
WriteHex (Resource[n]);
IF j # Resource[17] THEN WriteLine (', ', FALSE); END;
INC (n); INC (j, 2);
END; (* FOR *)
mtTextfiles.WriteLn (out);
END; (* LOOP *)
mtTextfiles.WriteLn (out);
WriteLine (' }; (* Ende RscData *)', TRUE);
ELSIF compiler = array THEN
(* Typ schreiben *)
WriteLine ('VAR RscData = ARRAY [0..', FALSE);
mtTextfiles.WriteCard (out, Resource[17] DIV 2, 0);
WriteLine ('] OF CARDINAL;', TRUE); WriteLine (' ', TRUE);
(* Daten schreiben *)
WriteLine ('PROCEDURE InitRscData;', TRUE);
WriteLine ('BEGIN', TRUE);
j:= 0; n:= 0;
LOOP
IF j > Resource[17] THEN EXIT END;
WriteLine (' RscData[', FALSE);
mtTextfiles.WriteCard (out, n, 0);
WriteLine (']:= ', FALSE);
WriteHex (Resource[n]);
WriteLine ('; ', TRUE);
INC (n); INC (j, 2);
END; (* LOOP *)
WriteLine ('END InitRscData;', TRUE);
ELSE
IF compiler = tdi THEN
(* Prozedur schreiben *)
WriteLine ('(*$S-, $T-, $P-*)', TRUE);
END;
WriteLine ('PROCEDURE RscData;', TRUE);
WriteLine ('BEGIN', TRUE);
j:= 0; n:= 0;
LOOP
IF j > Resource[17] THEN EXIT END;
IF compiler = tdi THEN WriteLine (' CODE (', FALSE);
ELSE WriteLine (' INLINE (', FALSE);
END;
FOR i:= 0 TO 7 DO
IF j > Resource[17] THEN EXIT END;
WriteHex (Resource[n]);
IF (j # Resource[17]) AND (i # 7) THEN
WriteLine (', ', FALSE);
ELSIF i = 7 THEN
WriteLine (');', FALSE);
END;
INC (n); INC (j, 2);
END; (* FOR *)
mtTextfiles.WriteLn (out);
END; (* LOOP *)
WriteLine (');', TRUE);
WriteLine ('END RscData;', TRUE);
IF compiler = tdi THEN WriteLine ('(*$S=, $T=, $P=*)', TRUE); END;
END; (* IF compiler *)
WriteLine ('(*----------------------------------------------------------------------*)', TRUE);
mtTextfiles.CloseTextfile (out);
END; (* Opentextfile *)
END; (* IF GetDir *)
END; (* IF GetDir *)
EXCL (main^[objc].obState, MagicAES.SELECTED);
mtDials.DialDraw (main, objc, 0, clip, FALSE);
END; (* IF objc = Formm2 *)
END; (* LOOP *)
mtDials.DialForm (main, mtDials.DSHRINK, rect, clip);
mtDials.DialForm (main, mtDials.DFINISH, clip, clip);
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
mtAppl.ApplTerm (0);
END RscCoder.